home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1998 / MacHack 1998.toast / The Hacks! / PCA Icon Arranger ƒ / MathDeclarations.p < prev    next >
Encoding:
Text File  |  1998-06-20  |  8.2 KB  |  311 lines  |  [TEXT/PJMM]
  1. unit MathDeclarations;
  2.  
  3. interface
  4.  
  5.     uses
  6. {$IFC undefined THINK_PASCAL}
  7.         Types, Memory, 
  8. {$endc}
  9.         Assertions;
  10.     const
  11.  
  12. {    MAX_LENGTH = 1000;}
  13. {    MAX_LENGTH = 32000;}
  14.         MAX_LENGTH = 64000;
  15. {    MAX_LENGTH = 178956970;}
  16. {    MAX_LENGTH = MAXLONGINT;}
  17.         ERR_RESULT = -999;
  18.  
  19.         global_epsilon = 1E-7;
  20.  
  21.     type
  22. { Je définis ces types une fois pour toutes afin d'éviter les problèmes multi-plateformes }
  23.         TReal = double;
  24.         TInteger = LongInt;
  25.         Str10 = string[10];
  26.         TString = Str10;
  27.         TMethodePermutation = (none, vector, matrix, double, triple);
  28.  
  29. { Nouvelle définition universelle de matrices }
  30.         TStrVector = array[1..MAX_LENGTH] of TString;
  31.         TStrVectorPtr = ^TStrVector;
  32.         TBoolVector = array[1..MAX_LENGTH] of Boolean;
  33.         TBoolVectorPtr = ^TBoolVector;
  34.         TIntegerVector = array[1..MAX_LENGTH] of TInteger;
  35.         TIntegerVectorPtr = ^TIntegerVector;
  36.         TRealVector = array[1..MAX_LENGTH] of TReal;
  37.         TRealVectorPtr = ^TRealVector;
  38.  
  39.         TColumnHeader = record
  40.                 n: TInteger;
  41.                 data: TRealVectorPtr;
  42.             end;
  43.  
  44.         TMatrixColumn = array[1..MAX_LENGTH] of TColumnHeader;
  45.         TMatrixColumnPtr = ^TMatrixColumn;
  46.  
  47.         TMatrix = record
  48.                 n, p, nbObjets, root: TInteger; { Paramètres de la matrice }
  49.                 col: TMatrixColumnPtr; { Accès aux données }
  50.                 colName, rowName: TStrVectorPtr; { Noms des colonnes }
  51.                 indirection, { Vecteur d'indirection pour permutations }
  52.                 group: TIntegerVectorPtr; { Pour grouper des objets ou des variables? }
  53.                 permMeth: TMethodePermutation; { Méthode de permutation si nécessaire }
  54.                 s1, s2, s3: StringPtr; { Pour conserver de l'information quelconque }
  55.             end;
  56.         TMatrixPtr = ^TMatrix;
  57.  
  58. { Création et accès aux matrices }
  59.     function InitMatrix (var m: TMatrixPtr): Boolean;
  60.     function TrouveNombreObjets (x: TInteger): TInteger;
  61.     function NewMatrix (var m: TMatrixPtr;
  62.                                     n, p: TInteger;
  63.                                     wantRowNames, wantColNames: Boolean): boolean;
  64.     procedure DisposeMatrix (var m: TMatrixPtr);
  65.  
  66. { Création d'un vecteur d'indirection pour permutations }
  67.     procedure CreerVecteurIndirection (mat: TMatrixPtr);
  68.     procedure CreerVecteurGroupes (mat: TMatrixPtr);
  69.  
  70.     function GetElement (m: TMatrixPtr;
  71.                                     i, j: TInteger): TReal;
  72.     procedure SetElement (var m: TMatrixPtr;
  73.                                     i, j: TInteger;
  74.                                     value: TReal);
  75.     function GetColName (m: TMatrixPtr;
  76.                                     j: TInteger): TString;
  77.     procedure SetColName (var m: TMatrixPtr;
  78.                                     j: TInteger;
  79.                                     s: TString);
  80.     function GetRowName (m: TMatrixPtr;
  81.                                     i: TInteger): TString;
  82.     procedure SetRowName (var m: TMatrixPtr;
  83.                                     i: TInteger;
  84.                                     s: TString);
  85.     function CreateTString (var theStrVectorPtr: TStrVectorPtr;
  86.                                     count: TInteger): Boolean;
  87. implementation
  88.  
  89. { Mettre les valeurs de la matrice à zéro }
  90.     function InitMatrix (var m: TMatrixPtr): Boolean;
  91.     begin
  92.         m := TMatrixPtr(NewPtrClear(SizeOf(TMatrix)));
  93.         Assert(m <> nil);
  94.         if m <> nil then begin { Paranoid }
  95.             m^.n := 0;
  96.             m^.p := 0;
  97.             m^.nbObjets := 0;
  98.             m^.root := 0;
  99.             m^.col := nil;
  100.             m^.colName := nil;
  101.             m^.rowName := nil;
  102.             m^.indirection := nil;
  103.             m^.group := nil;
  104.             m^.permMeth := none;
  105.             m^.s1 := nil;
  106.             m^.s2 := nil;
  107.             m^.s3 := nil;
  108.             InitMatrix := true;
  109.         end
  110.         else
  111.             InitMatrix := false;
  112.     end; { InitMatrix }
  113.  
  114.     function TrouveNombreObjets (x: TInteger): TInteger;
  115.         var
  116.             sqrtInteger: TInteger;
  117.     begin
  118. {$IFC not undefined THINK_PASCAL}
  119.         sqrtInteger := trunc(Sqrt(8 * x + 1));
  120. {$elsec}
  121.         sqrtInteger := system.trunc(Sqrt(8 * x + 1));
  122. {$endc}
  123.         if (sqrtInteger * sqrtInteger) = (8 * x + 1) then { la racine carrée est un nombre entier }
  124.             TrouveNombreObjets := (1 + sqrtInteger) div 2
  125.         else
  126.             TrouveNombreObjets := 0;
  127.     end; { TrouveNombreObjets }
  128.  
  129.     function NewMatrix (var m: TMatrixPtr;
  130.                                     n, p: TInteger;
  131.                                     wantRowNames, wantColNames: Boolean): boolean;
  132.         var
  133.             result: boolean;
  134.             i: TInteger;
  135.     begin
  136.         result := false; { Ca ne marche pas pour le moment }
  137. { As-t-on déjà une matrice? Possible... }
  138.         if (m <> nil) then
  139.             if (m^.n = n) and (m^.p = p) then
  140.                 result := true;
  141.  
  142.         if not result then { On n'avait pas déjà de matrice... }
  143.             if InitMatrix(m) and (n > 0) and (p > 0) then begin
  144.                 result := true;
  145.                 m^.n := n;
  146.                 m^.p := p;
  147.                 m^.nbObjets := TrouveNombreObjets(n);
  148.                 if wantColNames then
  149.                     result := CreateTString(m^.colName, p);
  150.                 if wantRowNames then
  151.                     result := CreateTString(m^.rowName, n);
  152.                 m^.col := TMatrixColumnPtr(NewPtrClear(SizeOf(TColumnHeader) * p));
  153.                 if m^.col <> nil then begin
  154.                     for i := 1 to p do begin { Créer chaque colonne }
  155.                         m^.col^[i].n := n;
  156.                         m^.col^[i].data := TRealVectorPtr(NewPtrClear(SizeOf(TReal) * n));
  157.                     end; { for i }
  158.                     for i := 1 to p do { Vérifier que tout s'est bien passé }
  159.                         if (m^.col^[i].data = nil) then
  160.                             result := false;
  161.                 end { if m^.col }
  162.                 else
  163.                     result := false;
  164.             end; { if > 0 }
  165.         NewMatrix := result;
  166.     end; { NewMatrix }
  167.  
  168.     procedure DisposeMatrix (var m: TMatrixPtr);
  169.         var
  170.             i: TInteger;
  171.     begin
  172.         if m <> nil then begin
  173.             if m^.col <> nil then begin
  174.                 for i := 1 to m^.p do begin { Effacer chaque colonne }
  175.                     m^.col^[i].n := 0;
  176.                     if m^.col^[i].data <> nil then
  177.                         DisposePtr(Ptr(m^.col^[i].data));
  178.                 end; { for i }
  179.                 DisposePtr(Ptr(m^.col));
  180.             end; { if m.col }
  181.             if (m^.colName <> nil) then
  182.                 DisposePtr(Ptr(m^.colName));
  183.             if (m^.rowName <> nil) then
  184.                 DisposePtr(Ptr(m^.rowName));
  185.             if (m^.indirection <> nil) then
  186.                 DisposePtr(Ptr(m^.indirection));
  187.             if (m^.group <> nil) then
  188.                 DisposePtr(Ptr(m^.group));
  189.             if (m^.s1 <> nil) then
  190.                 DisposePtr(Ptr(m^.s1));
  191.             if (m^.s2 <> nil) then
  192.                 DisposePtr(Ptr(m^.s2));
  193.             if (m^.s3 <> nil) then
  194.                 DisposePtr(Ptr(m^.s3));
  195.             DisposePtr(Ptr(m));
  196.         end;
  197.         m := nil;
  198.     end; { DisposeMatrix }
  199.  
  200.     procedure CreerVecteurIndirection (mat: TMatrixPtr);
  201.         var
  202.             i, n: TInteger;
  203.     begin
  204.         Assert(mat <> nil);
  205.         if mat^.permMeth = vector then
  206.             n := mat^.n { permutations sur toute la longueur d'une colonne }
  207.         else
  208.             n := mat^.nbObjets; { Permutations simultanées lignes/colonnes }
  209.         mat^.indirection := TIntegerVectorPtr(NewPtrClear(n * SizeOf(TInteger)));
  210.         if mat^.indirection <> nil then
  211.             for i := 1 to n do
  212.                 mat^.indirection^[i] := i;
  213.     end; { CreerVecteurIndirection }
  214.  
  215.     procedure CreerVecteurGroupes (mat: TMatrixPtr);
  216.         var
  217.             i, n: TInteger;
  218.     begin
  219.         Assert(mat <> nil);
  220.         if mat^.permMeth = vector then
  221.             n := mat^.n { groupes d'objets dans matrice rectangulaire }
  222.         else
  223.             n := mat^.nbObjets; { matrice de distance }
  224.         mat^.group := TIntegerVectorPtr(NewPtrClear(n * SizeOf(TInteger)));
  225.         if mat^.group <> nil then
  226.             for i := 1 to n do
  227.                 mat^.group^[i] := 0; { 0 = aucun groupe pour le moment }
  228.     end; { CreerVecteurGroupes }
  229.  
  230.     function GetElement;
  231.         var
  232.             result: TReal;
  233.     begin
  234.         result := ERR_RESULT;
  235.         Assert(m <> nil);
  236.         if m <> nil then
  237.             if (i > 0) and (i <= m^.n) and (j > 0) and (j <= m^.p) then
  238.                 if m^.col <> nil then
  239.                     if m^.col^[j].data <> nil then
  240.                         result := m^.col^[j].data^[i];
  241.         GetElement := result;
  242.     end; { GetElement }
  243.  
  244.     procedure SetElement;
  245.     begin
  246.         Assert(m <> nil);
  247.         if m <> nil then
  248.             if (i > 0) and (i <= m^.n) and (j > 0) and (j <= m^.p) then
  249.                 if m^.col <> nil then
  250.                     if m^.col^[j].data <> nil then
  251.                         m^.col^[j].data^[i] := value;
  252.     end; { SetElement }
  253.  
  254.     function GetColName;
  255.         var
  256.             result: TString;
  257.     begin
  258.         result := 'none';
  259.         Assert(m <> nil);
  260.         if m <> nil then
  261.             if (j > 0) and (j <= m^.p) then
  262.                 if m^.colName <> nil then
  263.                     result := m^.colName^[j]
  264.                 else
  265.                     result := StringOf(j);
  266.         GetColName := result;
  267.     end; { GetColName }
  268.  
  269.     procedure SetColName;
  270.     begin
  271.         Assert(m <> nil);
  272.         if m <> nil then
  273.             if (j > 0) and (j <= m^.p) then
  274.                 if m^.colName <> nil then
  275.                     m^.colName^[j] := s;
  276.     end; { SetColName }
  277.  
  278.  
  279.     function GetRowName;
  280.         var
  281.             result: TString;
  282.     begin
  283.         result := 'none';
  284.         Assert(m <> nil);
  285.         if m <> nil then
  286.             if (i > 0) and (i <= m^.n) then
  287.                 if m^.rowName <> nil then
  288.                     result := m^.rowName^[i]
  289.                 else
  290.                     result := StringOf(i);
  291.         GetRowName := result;
  292.     end; { GetRowName }
  293.  
  294.     procedure SetRowName;
  295.     begin
  296.         Assert(m <> nil);
  297.         if m <> nil then
  298.             if (i > 0) and (i <= m^.n) then
  299.                 if m^.rowName <> nil then
  300.                     m^.rowName^[i] := s;
  301.     end; { SetRowName }
  302.  
  303.     function CreateTString;
  304.     begin
  305.         CreateTString := True;
  306.         theStrVectorPtr := TStrVectorPtr(NewPtrClear(SizeOf(TString) * count));
  307.         if (theStrVectorPtr = nil) then
  308.             CreateTString := False;
  309.     end; { CreateTString }
  310.  
  311. end. { unit MathDeclarations }